home *** CD-ROM | disk | FTP | other *** search
/ ASME's Mechanical Engine…ing Toolkit 1997 December / ASME's Mechanical Engineering Toolkit 1997 December.iso / ai / prlg195b.lzh / GAMES.LZH / KTOUR.PRO < prev    next >
Text File  |  1987-05-15  |  7KB  |  178 lines
  1. /****************************************************************************/
  2. /*                                                                          */
  3. /*                            THE KNIGHT'S TOUR                             */
  4. /*                                                                          */
  5. /*                              by Tim Elliott                              */
  6. /*                                                                          */
  7. /*                                                                          */
  8. /*  Language: A.D.A. Prolog, ED version.  (Also runs under PD).             */
  9. /*                                                                          */
  10. /*  Requirements: Hardware must support graphics screen.                    */
  11. /*                                                                          */
  12. /*  Description: Solves the classic "knight's tour" puzzle.  A knight is    */
  13. /*               placed on a chessboard, and must visit each square once    */
  14. /*               (that is, EXACTLY once), eventually visiting the entire    */
  15. /*               board.                                                     */
  16. /*                                                                          */
  17. /*  Instructions: Once the A.D.A. Prolog interpreter is running, read       */
  18. /*                in the program by typing "consult(ktour)."  Then start    */
  19. /*                the tour with "tour(size)." where size is a number        */
  20. /*                from 1 to 9, 8 being the size of a standard chess board.  */
  21. /*                This will start the knight in the upper left-hand corner  */
  22. /*                of the board.  To start the tour at some other square,    */
  23. /*                type "tour(size,x,y)." where x and y are the coordinates  */
  24. /*                of the desired starting point.                            */
  25. /*                                                                          */
  26. /*                Note: the program makes notes to itself in the database   */
  27. /*                      with the built-in "asserta" predicate.  If it is    */
  28. /*                      interrupted abnormally, you may need to clean out   */
  29. /*                      these facts from the database.  You can do this     */
  30. /*                      by typing "reset." before restarting the program.   */
  31. /*                                                                          */
  32. /*        FOR MORE INFORMATION, READ THE ASSOCIATED KTOUR.DOC FILE          */
  33. /*                                                                          */
  34. /****************************************************************************/
  35.  
  36. tour(Size) :- tour(Size,1,1),!.        /* "top level" goal, short form   */
  37.  
  38. tour(Size,Xstart,Ystart) :-        /* & long form                    */
  39.     crtgmode(Screen),            /* save screen attributes */
  40.     board(Size),                /* draw board             */
  41.     claim(1,Xstart,Ystart),            /* put knight on board    */
  42.     proceed(2,Size),            /* ******** tour ******** */
  43.     crtset(Screen),                /* restore screen         */
  44.     reset,!.                /* clean up database      */
  45.  
  46. proceed(Movenum,Size) :-        /* one step toward a solution     */
  47.     Tmoves is Size * Size,
  48.     Movenum =< Tmoves,
  49.     claimed(Xnow,Ynow),!,
  50.     moves(Xnow,Ynow,Size,L),
  51.     exelist(Movenum,L),
  52.     Nnum is Movenum + 1,
  53.     proceed(Nnum,Size).
  54.  
  55. proceed(_,_) :-                /* recursion bottoms out here     */
  56.     curset(23,1,0),
  57.     put(7),print('Tour complete.  Find another?  (Y/N)'),
  58.     get0(Key),
  59.     curset(23,1,0),
  60.     put(7),print('                                     '),
  61.     not (Key = 121; Key = 89).    /* y or Y */
  62.  
  63. moves(X,Y,Size,L) :-             /* L = sorted list of legal moves */
  64.     kmove(Delx,Dely),
  65.     Xnew is X + Delx,
  66.     Xnew > 0, Xnew =< Size,
  67.     Ynew is Y + Dely,
  68.     Ynew > 0, Ynew =< Size,
  69.     not(claimed(Xnew,Ynew)),
  70.     nmoves(Xnew,Ynew,Size,Num),
  71.     asserta(move(Xnew,Ynew,Num)),
  72.     fail.    /* force to next line */
  73.  
  74. moves(_,_,_,L) :- movelist(L),!.
  75.  
  76. movelist(L) :-                /* accumulate & sort "move" facts */
  77.     not(move(_,_,_)),!,L = [].
  78.  
  79. movelist(L) :-
  80.     retract(move(X,Y,Num)),
  81.     movelist(L1),
  82.     goesin(X,Y,Num,L1,L).
  83.  
  84. goesin(X,Y,Num,[],[X,Y,Num]).        /* insertion sort                 */
  85.  
  86. goesin(X,Y,Num,[X1,Y1,Num1|T],[X,Y,Num,X1,Y1,Num1|T]) :-
  87.     Num < Num1.
  88.  
  89. goesin(X,Y,Num,[X1,Y1,Num1|T1],[X1,Y1,Num1|T]) :-
  90.     goesin(X,Y,Num,T1,T).
  91.  
  92. exelist(Movenum,[X,Y,_|T]) :-        /* "execute" move list            */
  93.     empty(X,Y),
  94.     claim(Movenum,X,Y).
  95.  
  96. exelist(Movenum,[_,_,_|T]) :-        /* drop 1st move off on backtrack */
  97.     exelist(Movenum,T).
  98.  
  99. nmoves(X,Y,Size,Number) :-        /* number of moves from (X,Y)     */
  100.     kmove(Delx,Dely),
  101.     Xnew is X + Delx,
  102.     Xnew > 0, Xnew =< Size,
  103.     Ynew is Y + Dely,
  104.     Ynew > 0, Ynew =< Size,
  105.     not(claimed(Xnew,Ynew)),
  106.     asserta(count),
  107.     fail.   /* force to next line */
  108.  
  109. nmoves(_,_,_,Number) :- sum(0,Number),!.
  110.  
  111. sum(Sofar,Total) :-             /* accumulate "count" facts       */
  112.     retract(count),
  113.     Acc is Sofar + 1,
  114.     sum(Acc,Total).
  115.  
  116. sum(Total,Total).            /* recursion bottoms out here     */
  117.  
  118. empty(X,Y) :- claimed(X,Y),!,fail.      /* empty fails if square claimed  */
  119.  
  120. empty(X,Y).                /* succeeds otherwise            */
  121.  
  122. empty(X,Y) :-
  123.     unclaim(X,Y),            /* "empties" square on backtrack */
  124.     !,fail.                /* before failing                */
  125.  
  126. claim(Number,X,Y) :-            /* claim a square on board       */
  127.     asserta(claimed(X,Y)),
  128.     Scr_col is 2 + 3 * X,
  129.     Scr_row is 1 + 2 * Y,
  130.     curset(Scr_row,Scr_col,0), 
  131.     print(Number).
  132.  
  133. unclaim(X,Y) :-                /* unclaim a square on board     */
  134.     retract(claimed(X,Y)),
  135.     Scr_col is 2 + 3 * X,
  136.     Scr_row is 1 + 2 * Y,
  137.     curset(Scr_row,Scr_col,0),
  138.     print('  ').
  139.  
  140. /* 1 */    kmove(  1, -2).            /* 8 possible knight's moves     */
  141. /* 2 */    kmove(  2, -1).
  142. /* 3 */    kmove(  2,  1).
  143. /* 4 */    kmove(  1,  2).
  144. /* 5 */    kmove( -1,  2).
  145. /* 6 */    kmove( -2,  1).
  146. /* 7 */    kmove( -2, -1).
  147. /* 8 */    kmove( -1, -2).
  148.  
  149. horizlines(X1,X2,Y) :-            /* draws horiz grid lines        */
  150.     drawline(X1,Y,X2,Y,1),
  151.     Ynew is Y - 16,
  152.     Ynew >= 20,
  153.     horizlines(X1,X2,Ynew).
  154.  
  155. horizlines(_,_,_).                  /* recursion bottoms out here    */ 
  156.  
  157. vertlines(Y1,Y2,X) :-            /* draws vert grid lines         */
  158.     drawline(X,Y1,X,Y2,1),
  159.     Xnew is X - 24,
  160.     Xnew >= 36,
  161.     vertlines(Y1,Y2,Xnew).
  162.  
  163. vertlines(_,_,_).                   /* recursion bottoms out here    */
  164.  
  165. board(Size) :-                /* oversees grid (board) drawing */
  166.     integer(Size), Size > 0, Size < 10,
  167.     cls, crtset(5),
  168.     X1 is 36,
  169.     X2 is 36 + 24 * Size,
  170.     Y1 is 20, 
  171.     Y2 is 20 + 16 * Size,
  172.     horizlines(X1,X2,Y2),
  173.     vertlines(Y1,Y2,X2).
  174.  
  175. reset :- retract(claimed(_,_)),fail.    /* predicate to clean out        */
  176. reset :- retract(move(_,_,_)),fail.    /* database.  Also useful if     */
  177. reset.                    /* program is interrupted.       */
  178.